home *** CD-ROM | disk | FTP | other *** search
/ Shareware Super Platinum 8 / Shareware Super Platinum 8.iso / mac / WIN_VB / VB_7DAYS.ZIP;1 / COPYFILE.BAS < prev    next >
Encoding:
BASIC Source File  |  1993-02-17  |  1.8 KB  |  57 lines
  1. Function CopyFile% (InFile$, OutFile$, ErrorNbr%)
  2.  
  3. 'Parameters ************************************************************
  4. '  Input values:
  5. '    InFile$     The name of the file to copy
  6. '    OutFile$    The new file to create
  7. ' Output value:
  8. '    ErrorNbr%   Zero if no error, otherwise the VB error number 
  9.  
  10. 'The function returns True (-1) if the file was successfully copied.
  11. 'Otherwise the function returns False (0), and places the error number 
  12. 'into the ErrorNbr% parameter
  13. '***********************************************************************
  14.  
  15.   On Error GoTo ErrorCopyingFile
  16.   BufferLen& = 28 * 1024& 'Set to a large string length
  17.   
  18.   ' Open files
  19.  
  20.   InFileNbr% = FreeFile  'Get next available file number
  21.   Open InFile$ For Binary Access Read Lock Read Write As InFileNbr%
  22.  
  23.   OutFileNbr% = FreeFile 'Get next available file number
  24.   Open OutFile$ For Binary Access Write Lock Read Write As OutFileNbr%
  25.  
  26.   ' Establish buffer length
  27.   
  28.   InFileLen& = LOF(InFileNbr%)
  29.   If InFileLen& < BufferLen& Then
  30.     BufferLen& = InFileLen&
  31.   End If
  32.   Buffer$ = Space$(BufferLen&) 'Initialize buffer
  33.  
  34.   Do 'Copy as much of file as possible in large blocks
  35.     Get #InFileNbr%, , Buffer$
  36.     Put #OutFileNbr%, , Buffer$
  37.   Loop While (Not EOF(InFileNbr%)) And (InFileLen& >= (Loc(InFileNbr%) + BufferLen&))
  38.   
  39.   If Not EOF(InFileNbr%) Then ' Copy rest of file if any
  40.     Buffer$ = Space$(InFileLen& - Loc(InFileNbr%))
  41.     Get #InFileNbr%, , Buffer$
  42.     Put #OutFileNbr%, , Buffer$
  43.   End If
  44.   
  45.   CopyFile% = -1  ' Function ended successfully
  46.   ErrorNbr% = 0  ' No error number to return
  47.  
  48. LeaveFunction:
  49.   Close #InFileNbr%, OutFileNbr%
  50.   Exit Function
  51.  
  52. ErrorCopyingFile:
  53.   CopyFile% = 0     'Return value that indicates function error
  54.   ErrorNbr% = Err   'Return specific error code
  55.   Resume LeaveFunction
  56. End Function
  57.